rm(list = ls())
setwd("~/Projects/news_tweets")
## --- Load Packages --- ##
library(rtweet)
library(dplyr)
library(ggplot2)
library(rvest)
library(tidyr)
library(wordcloud2)
library(igraph)
library(ggraph)
library(stringr)
library(tm)
library(tidytext)
library(stringi)
library(lubridate)

## --- Set Stylings --- ###
knitr::opts_chunk$set(message=FALSE, warning=FALSE)

theme_set(
  theme_bw(base_size = 14) +
    theme(
      plot.title = element_text(face = "bold", size = 14, 
                                margin = margin(0, 0, 4, 0, "pt")),
      plot.subtitle = element_text(size = 12),
      plot.caption = element_text(size = 6, hjust = 0),
      axis.title = element_text(size = 10),
      panel.border = element_blank()
    )
)

## --- Global Variables --- ##
# Define Color
Mycol <- RColorBrewer::brewer.pal(8, "Dark2")

# Define http pattern
http <- paste("http.*","https.*", sep = "|")

# Define Stopwords
stopwords <- data_frame(
  word =  stopwords("german")
) %>% rbind(
  data_frame(word = c("t.co","via","mal","dass","mehr", "amp","https",
                      "beim", "ab","sollen","ganz","sagt",
                      "schon","rt","gibt", "ja", "natürlich"))
)

Deutschsprachige Tweets die den Hashtag “#GERSWE” beinhalten. Die Tweets wurden mit Hilfe des R Packetes rtweet über die REST API ausgelesen. Der gesamte Code ist hier einzusehen.

Folgende Variablen sind in unserem Datensatz vorhanden.

load("../../data/germex.Rda")
attr(rt$created_at, "tzone") <- "Europe/Berlin"

start <- as.POSIXct("2018-06-17 16:00", tz = "Europe/Berlin")
end <- start + minutes(220)

gamestart <- as.POSIXct("2018-06-17 17:00", tz = "Europe/Berlin")
gameend <- gamestart + minutes(112)

rt_small <- rt %>% 
#  mutate(created_at = as.POSIXct(created_at + hours(2))) %>%
  filter(created_at >= start) %>%
  filter(created_at <= end)

Zeitraum

rt_small %>%
  ts_plot("1 minute",
        color = Mycol[3]) +
  geom_vline(xintercept = gamestart, color=Mycol[1], linetype = 2) +
  geom_vline(xintercept = gameend, color=Mycol[1], linetype = 2) +
  theme(plot.title = element_text(face = "bold"),
        axis.text.x = element_blank()) +
  labs(
    x = NULL, y = NULL,
    title = "Tweets zum Spiel Deutschland - Mexiko",
    subtitle = paste("Zeitraum:",min(rt$created_at),"bis",max(rt$created_at))
  )

Retweets

Welche Tweets wurden am häufigsten geteilt? Die top 10 sind:

rt_small %>%
  filter(is_retweet == FALSE ) %>%
  dplyr::select(screen_name, text, retweet_count) %>%
  group_by(screen_name, text) %>%
  summarise(retweet_count = sum(retweet_count)) %>%
  arrange(desc(retweet_count)) %>%
  .[1:10,] %>%
    htmlTable::htmlTable(align="l")
screen_name text retweet_count
1 DFB_Team Schluss! #DieMannschaft verliert den WM-Auftakt gegen Mexiko. #GERMEX 0-1 #ZSMMN https://t.co/wE73FNLBrv 1356
2 ThatRexGuy Joachim Löw when literally anything happens. #GERMEX #WorldCup https://t.co/5e0xQ9Q3Yy 1172
3 KuehniKev Sportminister ist in #Deutschland übrigens Horst Seehofer. 🤷🏼‍♂️ #GERMEX 906
4 DerWachsame Wir haben ein Fußballspiel verloren, das ist traurig, aber nicht schlimm. Morgen wird vielleicht ein durchgeknallter Innenminister im Alleingang die Grenzen schließen und die Regierung sprengen. DAS ist schlimm. #GERMEX 801
5 ghensel Mal im Ernst. Rausfliegen in der Vorrunde passt doch bombe zu unserer masochistischen Gefühlslage gerade. Ich sehe schon die Talkshow-Themen vor mir: „Deutsches WM-Aus. Welche Rolle spielt der Islam?“ #GERMEX 499
6 DFB_Team Seid ihr bereit für #GERMEX 🇩🇪🇲🇽? #ZSMMN #WM2018 #GERMEX https://t.co/POxvqBKDBj 491
7 DFB_Team Auf geht’s, Männer!!! 🇩🇪🇲🇽 #ZSMMN #WM2018 #GERMEX 0-0 https://t.co/l13goZrece 470
8 DFB_Team Halbzeit. Mund abputzen. Da geht noch was, Männer! #GERMEX 0-1 #DieMannschaft #ZSMMN https://t.co/0ZJu1R64iL 443
9 OomenBerlin

Seit wir Nazis im Bundestag haben hat die #Nationalmannschaft noch kein WM-Spiel gewonnen. Denkt mal drüber nach.

#GERMEX #WM2018 		440
10 FCBayern

🇩🇪 Kopf hoch, Männer! #WeiterImmerWeiter

#GERMEX #DieMannschaft #WM2018 https://t.co/CLHAah2jJo 		431

Wordcloud

rt_clean <- rt_small %>%
  # First, remove http elements manually
  mutate(stripped_text = gsub(http,"", text)) %>%
  mutate(stripped_text = gsub("germex","", text, ignore.case = T)) 
  
rt_tidy_words <- rt_clean %>%
  # Second, remove punctuation, convert to lowercase, add id for each tweet!
  dplyr::select(stripped_text) %>%
  unnest_tokens(word, stripped_text) %>%
  
  # Third, remove stop words from your list of words 
  anti_join(stopwords) %>%
  
  # Count Word occurences in a tweet
  count(word, sort = TRUE) 

rt_tidy_words %>%
  wordcloud2(size = 3, 
           color = "random-light", backgroundColor = "grey")

Wie sind die Wörter miteinander verlinkt?

word_network(rt_clean)

Sentiment Analyse

Lexikon Ansatz unter Verwendung des SentimentWortschatz

sent <- c(
  # positive Wörter
  readLines("../../dict/SentiWS_v1.8c_Negative.txt",
            encoding = "UTF-8"),
  # negative Wörter
  readLines("../../dict/SentiWS_v1.8c_Positive.txt",
            encoding = "UTF-8")
) %>% lapply(function(x) {
  # Extrahieren der einzelnen Spalten
  res <- strsplit(x, "\t", fixed = TRUE)[[1]]
  return(data.frame(words = res[1], value = res[2],
                    stringsAsFactors = FALSE))
}) %>%
  bind_rows %>% 
  mutate(word = gsub("\\|.*", "", words) %>% tolower,
         value = as.numeric(value)) %>%
  # manche Wörter kommen doppelt vor, hier nehmen wir den mittleren Wert
  group_by(word) %>% summarise(value = mean(value)) %>% ungroup
sentDF <- rt_clean %>%
  # Second, remove punctuation, convert to lowercase, add id for each tweet!
  unnest_tokens(word, stripped_text) %>%
  left_join(., sent, by="word") %>% 
  mutate(value = as.numeric(value)) %>% 
  #filter(!is.na(value)) %>%
  mutate(negative = ifelse(value < 0, value, NA),
         positive = ifelse(value > 0, value, NA),
         negative_d = ifelse(value < 0, 1, 0),
         positive_d = ifelse(value > 0, 1, 0))

Wordclouds

Positive Wörter

Negative wörter

Top 10 positive Tweets

sentDF.grouped <- sentDF %>%
  group_by(status_id) %>%
  summarise(mean_value = mean(value, na.rm = T),
            sum_value = sum(value, na.rm = T),
            positive = sum(positive, na.rm = T),
            negative = sum(negative, na.rm = T)) %>%
  left_join(., rt_small %>% dplyr::select(status_id, screen_name, text, created_at),
            by = "status_id") %>%
  filter(!is.na(mean_value))

sentDF.grouped %>%
  arrange(desc(mean_value)) %>%
  select(screen_name, text, mean_value, created_at) %>%
  .[1:10,] %>%
    htmlTable::htmlTable(align="l")
screen_name text mean_value created_at
1 Hessenfriese @BILD Ist uns fast gelungen….. #GERMEX #WM2018 https://t.co/quDq0wTnMX 1 2018-06-17 17:01:12
2 Mastermind_09 Draxler und Reus bislang ungefähr mit gleich vielen gelungen Ballaktionen. #GERMEX 1 2018-06-17 17:22:02
3 GmachtZumTxtn Noch nie ist es einer Mannschaft gelungen seinen eigenen Linksverteidiger so aus dem Spiel zu nehmen #GERMEX 1 2018-06-17 18:37:26
4 nerdfromaustria Der Sonntag wäre perfekt, wenn Deutschland eins auf die Nase kriegt… Ganz neutral gesprochen ;) #GERMEX #WM2018 0.7299 2018-06-17 16:12:47
5 DerFilmer That feel wenn der @BR24 Radiokommentar perfekt synchron zum @BBCSport Fernsehbild ist. #GERMEX #WM2018 0.7299 2018-06-17 17:11:25
6 mir70 Kimmich passt vom Sympathiefaktor perfekt zum FC Bayern … #GERMEX 0.7299 2018-06-17 17:26:16
7 nerow1909 @Endi_AJ Wer gerade mal seinen lamborghini ausfahren will, kann das gerade perfekt tun. Auch in der kölner innenstadt. #germex 0.7299 2018-06-17 17:31:51
8 Sarpei007 Naja. Die Taktik von Mex ist halt perfekt gegen die immergleiche Aufstellung/Taktik von uns. #GERMEX 0.7299 2018-06-17 17:46:21
9 allo_morph Ich nutze auch perfekt die Räume. Im Schlafzimmer schlafe ich, im Wohnzimmer wohne ich, im Badezimmer dusche ich…och Menno! #GERMEX 0.7299 2018-06-17 17:54:25
10 hassanscorner Man muss aber auch sagen, dass der Testspielgegner Saudi-Arabien die Mexikaner perfekt simuliert hat. #GERMEX 0.7299 2018-06-17 17:54:43

Top 10 negative Tweets

sentDF.grouped %>%
  arrange(mean_value) %>%
  select(screen_name, text, mean_value, created_at) %>%
  .[1:10,] %>%
  htmlTable::htmlTable(align="l")
screen_name text mean_value created_at
1 DieMone37 Neuer wird nicht in die Gefahr kommen einzuschlafen. #WM2018 #GERMEX -1 2018-06-17 17:02:47
2 hyouhakuhunter

Deine Meinungsfreiheit ist in Gefahr!

@fckart13 #FCKArt13 #GERMEX #WM2018 https://t.co/h8XhRv1Adu 		-1 2018-06-17 17:04:02
3 sirxwastaken

Das Internet ist in Gefahr und ihr habt nur Augen für einen Ball.

Schaut wenigstens in der Halbzeit mal vorbei und informiert euch!

https://t.co/QujMbEK3E1

#GERMEX #fckart13 #WM2018 #ger #mex #DieMannschaft 		-1 2018-06-17 17:04:22
4 sportwetten_de
  1. Min., 0:0: Aber auch Mexikos Freistöße sind eher eine Bewerbung für Fieldgoals beim Football als eine Gefahr für Manuel Neuer. #swde #GERMEX #liveticker #WM2018
-1 2018-06-17 17:10:31
5 Baumbart4Z0 Das freie Internet ist in Gefahr! #WM2018 #FCKArt13 #GERMEX https://t.co/lmKRfYI6bK -1 2018-06-17 17:13:00
6 anjaSeeBR Am 20/21.06 stimmt das EUparlament über Artikel 13 ab. Memes, Videos, Remixe, Parodien, Zitate sind in Gefahr #Meinungsfreiheit

Informier dich: https://t.co/KhlVEENOXh

#GERMEX #WM2018 #savetheinternet #FCKArt13 #SaveOurInternet 		-1 2018-06-17 17:20:59
7 Winkendekatze

SCHAUT NICHT WEG! Das Internet ist in Gefahr!

WM2018

GERMEX

#FCKart13 https://t.co/SLDh8eSEav
-1 2018-06-17 17:22:28
8 Jan_04 Teilweise vogelwild - auf beiden Seiten. An sich mal ein ganz angenehmer Kontrast zum kontrollierten Fußball in der Bundesliga. Birgt aber die Gefahr, dass beim Abpfiff 80 Millionen Deutsche Boatengs Haarfarbe haben. #GERMEX #WM2018 -1 2018-06-17 17:23:29
9 marcelbuslay Am 20. Juni 2018 wird über Artikel 13 abgestimmt. Helft mit das Zensurgesetzt zu verhindern bevor es zu spät ist. Informiere dich jetzt: https://t.co/JeRueO11zn Deine Meinungsfreiheit ist in Gefahr! #FCKArt13 #savetheinternet #saveyourinternet #GERMEX https://t.co/7a1DQSsj6h -1 2018-06-17 17:25:20
10 Kwn69943344

Das Internet ist in Gefahr! Informier dich! #WM2018 #GERMEX #FCKart13

https://t.co/zmDr4x4lxM https://t.co/6wbQTu4ybH 		-1 2018-06-17 17:28:54

Sentiment im Zeitveraluf